home *** CD-ROM | disk | FTP | other *** search
/ Windows 95 Super Collection / Windows 95 Super Collection.iso / win95 / programm / winscrp / commctrl.bas < prev    next >
Encoding:
BASIC Source File  |  1995-05-19  |  5.9 KB  |  229 lines
  1. Option Explicit
  2.  
  3.  
  4. '-- AutoProcess Property
  5. Global Const HDC_AUTOPROCESS_NONE = 0
  6. Global Const HDC_AUTOPROCESS_SERIAL = 1
  7. Global Const HDC_AUTOPROCESS_KEY = 2
  8. Global Const HDC_AUTOPROCESS_BOTH = 3
  9.  
  10. '-- AutoScroll Property
  11. Global Const HDC_AUTOSCROLL_NONE = 0
  12. Global Const HDC_AUTOSCROLL_VERTICAL = 1
  13. Global Const HDC_AUTOSCROLL_HORIZONTAL = 2
  14. Global Const HDC_AUTOSCROLL_BOTH = 3
  15. Global Const HDC_AUTOSCROLL_VERTKEY = 4
  16.  
  17. '-- BackSpace Property
  18. Global Const HDC_BACKSPACE_DESTRUCTIVE = 0
  19. Global Const HDC_BACKSPACE_NON_DESTRUCTIVE = 1
  20.  
  21. '-- CaptureMode Property
  22. Global Const HDC_CAPTURE_STANDARD = 0
  23. Global Const HDC_CAPTURE_BINARY = 1
  24. Global Const HDC_CAPTURE_VISIBLE = 2
  25.  
  26. '-- ColorFilter Property
  27. Global Const HDC_COLOR_FULL = 0
  28. Global Const HDC_COLOR_GRAY = 1
  29. Global Const HDC_COLOR_MONO = 2
  30.  
  31. '-- Cursor Type Property
  32. Global Const HDC_CURSOR_BAR = 0
  33. Global Const HDC_CURSOR_BLOCK = 1
  34.  
  35. '-- CommEvent Property (OnComm Events)
  36. Global Const HDC_EV_SEND = 1
  37. Global Const HDC_EV_RECEIVE = 2
  38. Global Const HDC_EV_CTS = 3
  39. Global Const HDC_EV_DSR = 4
  40. Global Const HDC_EV_CD = 5
  41. Global Const HDC_EV_RING = 6
  42. Global Const HDC_EV_EOF = 7
  43. Global Const HDC_EV_XFER = 100
  44.  
  45. '-- CommEvent Property (OnComm Errors)
  46. Global Const HDC_ER_BREAK = 1001
  47. Global Const HDC_ER_CTSTO = 1002
  48. Global Const HDC_ER_DSRTO = 1003
  49. Global Const HDC_ER_FRAME = 1004
  50. Global Const HDC_ER_INTO = 1005
  51. Global Const HDC_ER_OVERRUN = 1006
  52. Global Const HDC_ER_CDTO = 1007
  53. Global Const HDC_ER_RXOVER = 1008
  54. Global Const HDC_ER_RXPARITY = 1009
  55. Global Const HDC_ER_TXFULL = 1010
  56.  
  57. '-- Emulation Property
  58. Global Const HDC_EMULATION_NONE = 0
  59. Global Const HDC_EMULATION_TTY = 1
  60. Global Const HDC_EMULATION_ANSI = 2
  61. Global Const HDC_EMULATION_VT52 = 3
  62. Global Const HDC_EMULATION_VT100 = 4
  63.  
  64. '-- Handshaking Property
  65. Global Const HDC_HANDSHAKING_NONE = 0
  66. Global Const HDC_HANDSHAKING_XONXOFF = 1
  67. Global Const HDC_HANDSHAKING_RTS = 2
  68. Global Const HDC_HANDSHAKING_RTSXONXOFF = 3
  69.  
  70. '-- KeyTranslation Property
  71. Global Const HDC_KEY_NONE = 0
  72. Global Const HDC_KEY_MANUAL = 1
  73. Global Const HDC_KEY_VT100 = 2
  74.  
  75. '-- XferProtocol Property
  76. Global Const HDC_XMODEM_CHECKSUM = 0
  77. Global Const HDC_XMODEM_CRC = 1
  78. Global Const HDC_XMODEM_1K = 2
  79. Global Const HDC_YMODEM_BATCH = 3
  80. Global Const HDC_YMODEM_G = 4
  81. Global Const HDC_ZMODEM = 5
  82. Global Const HDC_KERMIT = 6
  83. Global Const HDC_COMPUSERVE_BPLUS = 7
  84.  
  85. '-- XferStatus Property
  86. Global Const HDC_XFER_TERM_ERROR = -1
  87. Global Const HDC_XFER_TERM_OK = 0
  88. Global Const HDC_XFER_WAITING = 1
  89. Global Const HDC_XFER_FILE_READY = 2
  90. Global Const HDC_XFER_FILE_START = 3
  91. Global Const HDC_XFER_XFERING = 4
  92. Global Const HDC_XFER_SKIP = 5
  93. Global Const HDC_XFER_ABORT = 6
  94. Global Const HDC_XFER_FINISHED = 7
  95. Global Const HDC_XFER_LOSTCARRIER = 8
  96. Global Const HDC_XFER_TIMEOUT = 9
  97.  
  98. '-- XferStatusDialog Property
  99. Global Const HDC_XFERDIALOG_NONE = 0
  100. Global Const HDC_XFERDIALOG_MODELESS = 1
  101. Global Const HDC_XFERDIALOG_MODAL = 2
  102.  
  103. '-- Notification Property
  104. Global Const HDC_NOTIFICATION_MANUAL = 0
  105. Global Const HDC_NOTIFICATION_DRIVER = 1
  106.  
  107. Sub CenterForm (Frm As Form)
  108. '-- Places a form in the middle of the screen
  109.     
  110.     Frm.Left = (Screen.Width - Frm.Width) \ 2
  111.     Frm.Top = (Screen.Height - Frm.Height) \ 2
  112.  
  113. End Sub
  114.  
  115. Function GetConfigFileName$ ()
  116. '-- This routine returns your app's INI File name
  117.  
  118. Dim Period As Integer
  119. Dim AppName$
  120.  
  121.     AppName$ = App.EXEName
  122.     Period = InStr(AppName$, ".")
  123.     If Period Then
  124.         AppName$ = Left$(AppName$, Period - 1)
  125.     End If
  126.        
  127.     GetConfigFileName$ = AppName$ & ".INI"
  128.     
  129. End Function
  130.  
  131. Function ReadScreen$ (Comm1 As Control, Row, Col, NumChars)
  132. '-- Returns a string of text from the terminal window.
  133. '   Row and Col are 1 based. i.e. 1-25, 1-80
  134.  
  135. Dim L As Integer, I As Integer, LineCount As Integer, OffSet As Integer
  136. Dim CRLF$, Txt$
  137.  
  138.     '-- Check the No-Brainer Errors
  139.     If Row > Comm1.Rows Then
  140.         MsgBox "ReadScreen: Invalid Row argument"
  141.         Exit Function
  142.     ElseIf Col > Comm1.Columns Then
  143.         MsgBox "ReadScreen: Invalid Column argument"
  144.         Exit Function
  145.     End If
  146.  
  147.     '-- Define CRLF
  148.     CRLF$ = Chr$(13) & Chr$(10)
  149.  
  150.     '-- Determine the offset to the first column of the Row
  151.     Txt$ = Comm1.Text
  152.     L = Len(Txt$)
  153.     
  154.     '-- Determine the Offset
  155.     If Row > 1 Then
  156.         For I = 1 To L
  157.             If Mid$(Txt$, I, 2) = CRLF$ Then
  158.                 LineCount = LineCount + 1
  159.                 If LineCount = Row - 1 Then
  160.                     Exit For
  161.                 End If
  162.             End If
  163.         Next
  164.         OffSet = I + 1 + Col
  165.     Else
  166.         OffSet = Col
  167.     End If
  168.  
  169.     '-- Read the text
  170.     If OffSet + NumChars > L Then
  171.         MsgBox "ReadScreen: Invalid NumChars argument"
  172.         Exit Function
  173.     Else
  174.         ReadScreen$ = Mid$(Txt$, OffSet, NumChars)
  175.     End If
  176.  
  177. End Function
  178.  
  179. Function ZTrim$ (St$)
  180. '-- Trims trailing null bytes, tabs, carriage returns, and line feeds from a string,
  181. '   as well as trailing and leading spaces. Also converts embedded nulls to spaces.
  182.  
  183. Dim L As Integer, I As Integer
  184. Dim Z$, T$, CR$, LF$, S$, Tilde$
  185.  
  186.     Z$ = Chr$(0)
  187.     T$ = Chr$(9)
  188.     CR$ = Chr$(13)
  189.     LF$ = Chr$(10)
  190.     S$ = Chr$(32)
  191.     Tilde$ = "~"
  192.  
  193.     L = Len(St$)
  194.     
  195.     For I = 1 To L
  196.         Select Case Right$(St$, 1)
  197.             Case Z$, T$, CR$, LF$, S$
  198.                 If L > 1 Then
  199.                     St$ = Left$(St$, L - 1)
  200.                     L = L - 1
  201.                 Else
  202.                     St$ = ""
  203.                 End If
  204.             Case Else
  205.                 Exit For
  206.         End Select
  207.     Next
  208.     
  209.     '-- Replace imbedded Chr$(0)s
  210.     L = Len(St$)
  211.     For I = 1 To L
  212.         If Mid$(St$, I, 1) = Z$ Then
  213.             Mid$(St$, I, 1) = S$
  214.         End If
  215.     Next
  216.  
  217.     '-- Replace Tildes
  218.     L = Len(St$)
  219.     For I = 1 To L
  220.         If Mid$(St$, I, 1) = Tilde$ Then
  221.             Mid$(St$, I, 1) = S$
  222.         End If
  223.     Next
  224.     
  225.     ZTrim$ = Trim$(St$)
  226.  
  227. End Function
  228.  
  229.